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I * * * 

Copyright Mario CI- Murga, Health Informatics International, Inc. 1998 

i *** 

Option Explicit 

Public workingDirectory As String 
Public targetFolder As String 
Public conversions Folder As String 
Public footerExists As Boolean 
Public bottomRule As Booleln 
Public moduleName As String 
Public moduleGif As String 
Public moduleGif 2 As String 

Public moduleBack As String x name of background gif 

Public secondlndex As Boolean 

Public currentFile As String x so we only have to check once 

Public currFileWindow As String 
Public linkMapWindow As ' String 
Public docMapWindow As Strdjng 

Sub MainRoutine ( ) 

Application. DisplayScrollBars = False 
'Application. DisplaySt a tus Bar = False 
Application. ScreenUpda ting = False 

1 This is the main routine that runs the whole conversion shebang 

r ***!L l ignore (for now) the following files: 

*.art 
signon,* 

1 ***I3. menu.* 

Mm currFile As String 
Um namePart As String 
f§m extPart As String 
Dim saveName As String 
Dim messageText As String 



currFile = "" 
saveName « 
namePart = ,MI 
extPart = "" - - * 

messageText = "Enter module code:" & vbCr & _ 

"AHA - Adult Health Advisor" & vbCr & _ 
"PA - Pediatric Health Advisor" & vbCr & _ 
"BHA*- Behavioural Health Advisor" & vbCr & 
"WHA-- Women's Health Advisor" & vbCr & _ 
"SHA - Senior Health Advisor" & vbCr & _ 
"CA - Cardiac Health Advisor" & vbCr & _ 
"OA - Ophthalmology Health Advisor" & vbCr & 
"SMA - Sports Medicine Advisor" & vbCr & _ 
"MA - Medications Advisor" & vbCr 

moduleName = InputBox (messageText, "Module Name Entry", "AHA") 
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tweakModuleName _ x set some globals based on entered module name 

workingDirectory - ge^ArticlePath ()' A get working directory which contains raw articles 
targetFolder = makeTar get Folder (moduleName) ^create folder for converted arts, and indexes 
conversionsFolder = setConversionsFolder ("Conversions") 

Documents , Open 

f i 1 eN ame : =do cMap , _ 
ConfirmConversions:=False, _ 

addToRecentFiles : -False, 4 
Format : =wdOpenFormltText , _ 

Readonly :=T rue " *open docmap file 

Documents . Open _ 

fileName:=linkMap, _ 
ConfirmConversions :=False, 
addToRecentFiles:=False, _ 
Format :=wdOpenFormatText, _ 

Readonly :=T rue *open linkmap file 

currFile = Dir(" M ) 1 (workingDirectory) ^retrieve first file 

currFile = StrConv (currFile , vb Lowercase) 

_ ^ 

linkMapWindow = linkMap 
do cMap Window - docMap 

f yJDebug. Print currFile 

1 tfjDebug . Print workingDirectory 

sip While currFile <> "" *null string is returned when no more files in folder 

"> bottomRule = False % start out assuming no footer, will be set in footer/ copyr. routine 
TS name Part = getNamePart (currFile) ^seperate the current filename into namepart and 
exte}|jjsion part 

extPart - getExtPart (currFile) 
Select Case namePart 
T Case "credits" 

Case "signon" 
y Case "menu" 
P Case "linkmap" 
D Case "docmap" 
|^ Case Else 

Select Case extPart 
Case "art" 
Case "idx" 

Documents .Open _ 

f ileName : =curr File, _ 
- - ConfirmConversions:=False, _ 
addToRe cent Files r=False, _ 
Format :=wdOpenFormatText 
current File = Act iveDocument .Name 
currFileWindow = currentFile 
prep Index 
Case Else 

Documents .Open _ 

f ileName :=currFile, _ 
ConfirmConversions :=False, _ 
addToRecentFiles:=False, _ 
Format : -wdOpenFormatText 
currentFile - Acti veDocument . Name 
currFileWindow = currentFile 



* first check filename cases 

x skip conversion for credits file 

% skip conversion for signon file 

^skip conversion for menu file 

^skip conversion for linkmap. lmf 

x skip conversion for docMap.dmf 

^no filename exceptions, check extension cases 

11 skip cover sion for art holder files 
^convert the current file as an index 



A open current file for processing 

x get current filename sans path 
x so we can activate document windows 
A convert as index file 
^all exceptions checked for 



x open current file for processing 

*get current filename sans path 

x so we can activate document windows 



2 



7 * 

con vertAr tide x ok to do the standard conversion 

saveNairie = targetFolder & " : " & currFile & html HTML ^ 
DebugT Print "targetFolder: " & targetFolder 
Debug. Print "currFile: " & currFile 
Debug. Print "saveName: " & saveName 
With Documents (currFile) 

. SaveAs fileName :=s a veName, FileFormat :=wdFormatText 
.Close 
End With 

End Select j ^ 
End Select M 

currFile = Dir x get next file 

currFile = StrConv( currFile, vbLowerCase) 

Loop 

Documents (linkMap) .Close 
Documents (docMap) .Close 



Application. DisplayScrollBars = True 
'Application. Displays tatusBar = True 
Application. ScreenUpdating-^= True 
End Sub 

Private Function getArticlePath ( ) As String 

' Tne purpose of this function is to return the path 

1 for the articles to be converted 

t * * Sfeisg 

jifith Dialogs (wdDialogFileOpen) 

. Show 
*'End With 

* * * 

js^**** doesn't matter if a file is opened or not, 

yy*** CurDir returns the last navigated path 

j^f*** return value to calling 

Ij. *** 

getArticlePath = CurDir. 
End Function h 



Public Function getNamePart (ByVal fileName As String) As String 
i *** 

'*** Return the name^ part of a filename 

Dim dotLoc As Long 
dotLoc = InStr (fileName, ".") 
getNamePart = Left (fileName, dotLoc - 1) 
End Function 

Public Function getExtPart (ByVal fileName As String) As String 

■**■* Return the extension part of a filename 
i *** 

Dim dotLoc As Long 



dotLoc = InStr( fileName, ".") 



3 



getExtPart = Right ( filename, Len { f ileName) - dotLoc) 
End Function ~Z 

Public Function makeTargetFolder (ByVal targetFolder As String) As String 
t*** MkDir — > create a folder based on the current path 

r*** The part makes it go up one level before creating the directory 

i **+ . 

Dim saveDir As String J - 

MkDir & targetFolder ^create target folder on the same level as working folder 

saveDir = CurDir A save current folder to return to 

ChDir & targetFolder A go to newly created folder 

makeTargetFolder = CurDir *make the return value of this function be the created folder 

ChDir saveDir *go back to working folder 
End Function 

Public Function setConvers ions Folder (ByVal cFolder As String) As String 

r *** _ 

'*** MkDir — > create ar^f older based on the current path 
i * * * 

The part makes it go up one level before creating the directory 

Dim igaveDir As String 

agave Dir = CurDir x save current folder to return to 

|€piDir & cFolder *go to newly created folder 

JjgetConversions Folder = CurDir ^make the return value of this funct. be the created folder 
pjfiDir saveDir x go back to working folder 

End f function 

Public Sub convertArticle { ) 

t ^ 

f **i8 This file was created using FormatSpecialA thru D. 
>**tM These modules must be run in this order. 
Basically, do the article conversion 

multiReplace conversionsFolder & ":" & commentTags ^change raw tags to commented HTML 
specialText M [ H , "] htmlBoldStart, htmlBoldEnd, True, True ^replace [...] with 
<b>. . .</b> 

CreateTitle _ . ^ x make window and article title 

HideHeaderlnfo ^hide the med codes 

FooterCopyright ^prettify copyright info and nix CRS 

PreformattedListsandTables y add preformatting tags to tables and menus 

* *** 

Note that prior to running Step 3.b f two files named 
i*** "linkmap. Imf " and "docmap.dmf" needed to be available. 
» *** 
i 

DocumentAnchor A make links to other docs and pics 

SectionLinks A make links at top to inner sections 

MakeParagraphs A format paragraphs 

MakeLists _ x format bulleted and numbered lists 
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InsertTopText 'insert top text template 

InsertBottomText ^ ^insert bottom text template and tailaj: to module 

End Sub. 

1 == ~ = =— ===—==—=— ====== ===== =ss=s;r5=as===as=rs==:ss=rs=s=rs:s==s^=ss=^:ss=^ss== ========= ==rss==:=s=== 

Option Explicit 

Public Sub CreateTitle() 

i*** This routine finds the delimited article title and uses it 
**** to create the windcj* title and the displayed article title. 
1 *** Assumes tagged ascM. format. 

i*** This routine also adds the top and bottom tokens to the article, 
i *** 

Dim docTitle As String 

Dim windowTitle As String 

Dim miss End As Boolean 

Dim gotWindowTitle As Boolean 

**** 

docTitle = missingTitleDebug ^debugging title in case none found 

windowTitle = missingTitleDebug 'debugging title in case none found 

missEnd - False 
i *** 

_ Selection. HomeKey unit :=wdStory, Extend :-wdMove ^move to start of doc 
'^SimpleFind begTitleText A find first title 

^flbo While Selection. Find. Found 

U-3 Selection. MoveDown unit :=wdParagraph x move to line following begTitleText - assume it 
is 4bc title 

[fl Selection. ExtendMode = True * selection mode on 

~p SimpleFind endTitleText 'selection includes title and end tag 

Iff If Selection. Find. Found Then 

Ifi Selection. End = Selection. End - Len (endTitleText) ^deselect endTitletext leaving 

onl^y title selected 

Selection. End « Selection. End - 1 *get rid of spurious cr 

S Else 'jumpin jehosifat! no endTitleText tag found. 

Hi missEnd = True ^Assume title is one paragraph. 

Select ion. Move Down unit :=wdParagraph, Extend :=wdExtend 'move to end of hoped for 

ti|& 

P End If 

* w docTitle = Selection, Text 'save the title for cleaning 

If Not gotWindowTitle Then ^only do if no windo title yet 

windowTitle = stripDelimiters (docTitle, paraDelimiter, " ") 'remove par. delimiter 
gotWindowTitle = True ^show that window title is already accounted for 

End If 

docTitle siripDelimiters (docTitle, paraDelimiter, htmlBreak) 'replace paragraph 
delimiter with html break 

Selection. ExtendMode - False 

Selection. Text = htmlStartTitle & docTitle & htmlEndTitle * replace selected text with 
cleaned title with html tags 

Selection . Collaps e - wdCollapseEnd 

SimpleFind begTitleText 'find next title (subtitle in Spanish files) 

Loop 

SimpleFind endTitleText * find end tag again 

If Selection. Find. Found Then 

Selection. Collapse wdCollapseEnd 

Selection. Text = vbCr & af terTitleTag & vbCr & TopLinkTag 'leave a tags after last 

title 
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Selection •Collapse wdCollapseEnd 

End If -z ^ 

Selection. HomeKey unit :"=wdStory 'go back and insert top stuff for HTML & title 

Selection. Text = docTopToken & vbCr & htinlStartHead & _ 

windowTitle & htmlEndHead & vbCr 'insert token for start of doc and 

actual window title 

Selection. Collapse wdCollapseEnd 
If missEnd Then 

Selection. InsertAfter titleEndDebug £ vbCr * insert debug string 

Selection. Collapse yrdCollapseEnd . 
Selection. Text = vfcCr & afterTitleTag & vbCr & TopLinkTag 'leave a tags after last 

title 

End If 

Selection. EndKey unit :=wdStory 'go to bottom and insert bottom stuff for HTML & footer 
Selection, Text = vbCr & docBottomToken & vbCr 'insert token for end of doc 

Selection . Collapse wdCollapseEnd 
End Sub 



Option Explicit 



Public Sub DocumentAnchor tf 
» **> 

Modify document such that index targets are true html anchors and all hyperlinks are 
tru|Ehyperlinks 

T **V This macro must be run on files with original names, i.e no ".html" extension 



^jSim currentSection As String 

^iim currentSectionText As String 

*Bim est As String 

liim braceLoc As Long 

Cliim targetLetter As String 

a Dim currSectTarget As String 

Clim htmlLink As String 

{0*** 

Is!*** Initialize variables 



'linked title of section 
'body text between vTag and qTag 
'abbreviation of currentSelectiontext 
'location of begLink tag in est 
^letter between & link target! 

'currentSection plus targetLetter 
'resulting html link for targetLetter 



assumes every section title needs to also be an anchor 



Selection. HomeKey unit :=wdStory 

SimpIeFind cTag 

Do While Selection. Find. Found 

Select ion. Mo veDown unit : =wdPa rag raph 
section title . _ 

Selection. Text = startAnchorToken 
Selection. Collapse wdCollapseEnd 
Selection. Mo veDown unit :=wdParagraph, 
Selection. End = Selection. End - 2 
Selection. Range. Case = wdLowerCase 
currentSection = Selection. Text 
Selection. Collapse wdCollapseEnd 



'goto top of doc to know where we are 
^find first (usually only) article start 

'move to line following cTag - assume it is 

'insert token for start anchor definition 



Extend : =wdExtend 
^deselect leaving only 



'select rest of 
title selected 
change selection case to lower so links will work 
'save the title 
'move to end of and deselect 



Selection. InsertAfter endAnchorToken & 
Selection. Collapse wdCollapseEnd 



vbCr 'insert token for end anchor definition 



SimpIeFind vTag 'goto end of section header 

If Not Selection. Find. Found Then Selection. InsertAfter vTagDebug & vbCr 'hey, no vTag 

Selection. MoveDown. unit: =wdParagraph 'goto start of actual article body 
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Selection- ExtendMode = True 

SirnpleFind qTag ~ ^selection includes entire current section body 

If Not Selection. Ffnd. Found Then "now what, no qTag? 

Selection. ExtendMode = False 

Selection. InsertAfter qTagDebug & vbCr 'insert qTag debug message 

Selection. Collapse wdCollapseEnd 
Selection. ExtendMode = True 

Selection. EndKey unit :=wdStory "fake it by moving to end 

End If 

Selection. ExtendMocfe = False 'end extend selection so next find won't qhange selection 
currentSectionText 1= Selection . Text "put section text into a string to be manipulated 



r *** 

i *** 

i *** 

i *** 



This next routine looks through the current section text, which is selected at this 
point, and embeds HTML links to any any sections referenced between braces, i.e. I, or 
A, etc. It will do this by copying the selection into a string variable and searching 
for occurances of begLink and endLink, currently: 

»» - any single character - "". The and "" characters replaced the "<" and ">" '*** 
characters in the mass replacements routine to not conflict with embedded html tags. 
The single character between the braces will be used along with currentSection$ to 
'*** pull the target filename and section name out of the Link Map and Document Map arrays. 

This action will be repeated until no more ? strings are found. 
1***3. Processing will then proceed with the next section, etc. 

Note that references that return a file named *.art will be handled specially since 
r **tf this is where the GIF thumbnail and link to the JPEG picture is inserted 



1 *** 
! *** 
I *** 



**b 



foufS 



est = currentSectionText 'needed a shorter name to work with 

braceLoc = InStrlcst, begLink) 'find location of which starts "?" 

Do While braceLoc > 0 x if a brace was found 

If Mid (est, braceLoc + 2, 1) - endLink Then x if second following char is 

targetLetter = LCase (Mid{cst, braceLoc +1, 1) ) Valid single index letter was 

currSectTarget = currentSection + "~" & targetLetter 'build target for link 

map^array , 

.p. htmlLink = extractLink (currSectTarget) ^extract target section from link map 

arrmf & file map array 

?T est = Left (est, braceLoc - 1) & _ 

r " htmlLink & 

Right(cst, (Len(cst) - (braceLoc +2))) 'build new section text 

including HTML link in place of 

^remember: htmlLink might be debug text 
Else 'must have originally been an isolated "<" symbol 
est ~ L^ftfcst, braceLoc - 1) & _ 
htmlLessThan & _ 

Right(cst, (Len(cst) - braceLoc)) 'put the less than symbol back in 

End If 

^** 

**** start search after last "" found in case there are braces 
**** not of the form, so it won't infinite loop 



^** 



braceLoc « InStr (braceLoc + 1, est, begLink) 'find location of next 

Loop 

currentSectionText = est x go back to longer name 

Selection. Text = currentSectionText 'replaces currently selected section 

x text with newly built linked version 



7 



Selection. Collapse wdCollapseEnd 

SimpleFind cTag ^ "find next section 

Loop 
End Sub 

, i **** * ***** ************ *** ************* **************************** 

r*** Extract target section from link map array & file map array 

**************************************** *********************** 



Private Function extractLirJc (ByVal target As String) As String 

Dim currSection As String 

Dim linkSection As String 

Dim linkDoc As String 

Dim art As String 

Dim dot As Long 

Dim jpegName As String 

Dim gifName As String 



currSection = cur rent File & "-" & target 

linkSection = sectionToSection (currSection) 
If linkSection = mi ssingLinkMap Debug Then 

O extractLink = linkSection 

v3 Documents ( currFileWindow) • Activate 

■%g Exit Function 

4End If 

IflinkDoc = sectionToDoc (linkSection) 

jSjff linkDoc « missingDocMapDebug Then 

ifl extractLink = linkDoc 

JJi Documents ( currFileWindow) .Activate 

l'" Exit Function 

jLfnd If 

Jjocuments (currFileWindow) .Activate 
fikrt = Right (linkDoc, 3) 



'prepend current file to current section 
^name for use in the link from array 
'call to search link map file 
'check for missing linkmap target 
'return debug message 

"make sure we re-activate working window 



'call to read doc map file 
'check for missing docmap target 
'return debug message 

"make sure we re-activate working window 



'make sure we re-activate working window 
'Check to see if file to link to 
'is of the form "*.art" for special handling 
'this is an art ink 



ytf art = "art" Then 
P dot = InStr (linkDoc, ".") 

If dot > 1 Then linkDoc = Left (linkDoc, dot - 1) 

jpegName = linkDoc r & jpg" 

gifName - linkDoc & "«gif" 

extractLink « htmlBreak & htmlAStart & qq & artDir & jpegName & 
htmlET & htmllmgStart & qq & artDir & gifName & 



'take only the file name sans ext. 
'build jpeg filename 
'buld gif filename 

qq & _ 
qq & _ 



Else 



^ htmllmgEnd & htmlPressHere & htmlAEnd & htmlBreak 

"this is a regular link 



extractLink « htmlBreak & htmlAStart & qq & 
linkSection & qq & htmlET & 



linkDoc & htmlHTML & ttt & 
htmlGoThere & htmlAEnd 



End If 
End Function 



i ********************************************************************** 
'*** reads link map file to find target section 

t ******* ****************************************************** ********* 



Private Function sectionToSection (ByVal cs As String) As String 
i *** 

**** cs = filename + "-" + target letter 



8 



1 *** 
t *** 



ts = target section 
sts = line containing target section 

Dim ts As String 
Dim sts As String 
Dim firstTilde As Long 
Dim secondTilde As Long 

Documents (linkMapWindow) .Activate 
ts - "" | 
sts = 1 

Selection. HomeKey unit : =wdStory 



^activates linkmap doc window 

'go to top of doc 
'goes right to the proper line 



'extend selection to end of paragraph 
'don't include mark 



SimpleFind cs 

If Selection. Find. Found Then 

Selection. ExtendMode = True 
Selection . MoveDown unit : =wdParagraph 
Selection. End = Selection. End - 1 
Selection. ExtendMode = False 

sts = Selection. Te^t *put selection into a string to be manipulated 

firstTilde = InStr(sts, "~") 'find location of 1st "~" 

secondTilde = InStr (firstTilde + 1, sts, "-") ^find location of 2nd "~" 

S3 ts = Right(sts, (Len(sts) - (secondTilde +2))) ^extract target section 

%fllse 

%p ts = missingLinkMapDebug ^target not found 

,Ind If 



„3ectionToSection = ts 
[documents (currFileWindow) .Activate 
Endf function 



'return target section 

'activates current article doc window 



, **|,.************* ****** ********* *************************************** 

'reaSis doc map file to find target section 
, **|^i ****** ******* 



PriJgLte- Function sectionToDoc (ByVal Is As String) As String 

i**M- i s = link section returned by sectionTosection function 
t *** - 

Dim td As String 
Dim std As String 
Dim firstTilde As Long 



^extracted target section 
*line containing target section 



Documents (docMapWindow) .Activate 
td = 
std = 

Selection* HomeKey unit :.=wdStory 
SimpleFind Is 

If Selection. Find. Found Then 

Selection. ExtendMode = True 
Selection .MoveDown unit : =wdParagraph 
Selection. End = Selection. End - 1 
Selection. ExtendMode = False 
std = Selection. Text 



'activate docmap doc 

'start at top of document 
'goes right to the proper line 



'extend selection to end of paragraph 
'don ! t include mark 

'put selection into a string to be manipulated 
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firstTilde = InStr(std, n ~") 

td = Right (std f (LSi(std) - firstTilde)) 

Else 

td = missingDocMapDebug 
End If 

sectionToDoc = td 

Documents (currFileWindow) .Activate 
End Function 



^find location of 1st "~" 
^extract target section ^= 

^target not found 

'return target 

'activates current article doc window 



Mo "/copyright" case 

Mo " . F" case 

* strip CRS Copyright 

x add horizontal rule if not added in footer routiners above 

'always know where you are (top) 



vbCr 



Option Explicit 
Public Sub FooterCopyright ( ) 

f ooterSection crTag 

footerSection fTag 

deleteCRSCopyright 

If Not bottomRule Then 

Selection. HomeKey unit :=wdStory 
SimpleFind qTag 
If Selection. Find. .Sound Then 

Selection. Collc^pse wdCollapseStart 

Selection. Text « htmlHorizontalRule & 

bottomRule = True 

W Else 

V3 SimpleFind docBottomToken 

%Q If Selection. Find. Found Then 

J£ Selection. Collapse wdCollapseStart 'insert in front of docBottomToken 

|fl Selection. Text = htmlHorizontalRule & vbCr ^add horizontal rule rule 

jg bottomRule « True x we added a bottom rule 

ih End If x hey if we can f t find the bottom at this point we're in trouble 

|| End If 

™ Selection. Collapse wdCollapseEnd 

f$nd If 
Endl|ub 



^insert in front of qTag 
^add horizontal rule rule 
'we added a bottom rule 

'find doc bottom a different way 



Public Sub footerSection (footerType As String) 
★ * * 

W*** beautify article copyright footer section 
H *** 



Selection. HomeKey unit :=wdStory 
SimpleFind footerType 
Do While Selection. Find. Found 
bottomRule = True 



'always know where you are (top) 
'find footer tag 
'works for either 
'set global flag to prevent double <hr> at bottom 

A start of footer section HTML 



Selection. Text = footerType & htmlStartArticleFooter 
Selection. Collapse wdCollapseEnd 

SimpleFind qTag y go to end of article copyright footer 

If Selection. Find. Found Then 

Selection. ExtendMode = False *end extend selection 

Selection. Collapse direction :=wdCollapseStart ^insertion point at start of .Q tag 
Selection. InsertAfter htmlEndArticleFooter & vbCr ^end of footer HTML 

Selection. Collapse wdCollapseEnd 

Else 

Selection. EndKey unit :=wdStory 
Selection. InsertAfter htmlEndArticleFooter 

(hopefully! ) 

Selection. Collapse wdCollapseEnd 
End If 



x move to end to add end Q tag 
qTagDebug & vbCr 'end of footer HTML 
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SimpleFind footerType 'satisfy while condition 

Loop ^ ~7 

End Sub 

Public Sub deleteCRSCopyright ( ) 
t *** 

Strip CRS copyright, if it exists, since it is added later 

i *** 

Selection. HomeKey unit^wdStory 'always know where you are (top) 

PatternFind wildCopyRi^it 'uses ???? pattern matching to allow all years 

If Selection. Find. Found Then 

Selection. MoveUp unit :=wdParagraph 'go to beginning of selection paragraph 
Selection. Range. Delete 'delete A p before 

Selection. MoveDown unit : =wdParagraph, Extend :=wdEx tend 'select para with copyright 

Selection. Text = deletedCopyrightDebug 'replace copyright with debug tag 

Selection. Collapse wdCollapseEnd 

Selection. ExtendMode = False 'cancel extend mode 

End If 

End Sub ~" 



Option Explicit 

Public Sub HideHeaderlnfoO 

***%fl This rountine comments out the header information of 
! **tp the article which includes the med codes. 

'**th Assumes there is a link anchor on the line following the cTag 

%,% i 

^election. HomeKey unit : =wdStory 'always know where you are (top) 

JjfimpleFind cTag 'assume it is there 

1 f^Debug. Print "HideHeaderlnfo Find cTag selection. find. found = " & Selection. Find. Found 
ijjjo While Selection. Find. Found 

Selection. MoveDown unit :=wdParagraph, Count:-2 'move to line following anchor 

. Selection. InsertAfter html St art Comment 'start of HTML comment 
Selection. Collapse wdCollapseEnd 

SimpleFind vTag : 'find known end of header info 

Debug. Print "HideHeaderlnfo vTag = " & vTag 
1 Debug. Print "HideHeaderlnfo Find vTag selection. find. found = 11 & Selection. Find. Found 
If Selection. Find. Found Then 'make sure there is a vTag 

Selection.MpveLeft Count: =2 'deselect vTag leaving only header info selected 

Selection. InsertAfter htmlEndComment & vbCr 'end of HTML comment plus a newline 
Selection. Collapse wdCollapseEnd 
Else 'uh-oh, no vTag! 

Selection. InsertAfter htmlEndComment & vTagDebug & vbCr 'insert a debugging 
comment, vTag missing 

Selection. Collapse wdCollapseEnd 
End If 

SimpleFind cTag 'in case there is another section - satisfy while 

Loop 
End Sub 

Option Explicit 



li 



These constants are used in searches 



t *** 












irUD-LxC wUSl. t_ixciy 


As 


String 




"<! — /copyright 


— >" 


Pn"hl i r* fnn^t fTaci 

JT -L. X w ,i» j. 


As 


String 


_ 


— # p >" 




cUDHC ^Olisu 


As 


String 




"<! — .Q — >" 




cUDllu UUUa L. 


As 


String 




"<!-- .C — >" 






As 


String 


— 


"<!— .V — >" 




IrUJjJLJ-O vUilk} l "ir y 


As 


String 




"/hp" 


'primary heading tag 


Public Const pTag 


As 


String 




n /p" 


'paragraph tag 


Public Const bliTag 




String 




"/bli " 


'bulleted list item tag _ 


Public Const numTag 




String 




"/numitem " 


'numbered list item tag ' 


Public Const letTag 


As 


String 




"/letteritem " 


'letter list item tag 


Public Const romTag 


As 


String 




"/letteritem " 


'roman numeral list item tag 



Public 

Public 

Public 

Public 
i 

Public 
Public 



Const pCommentTag 
Const hpCommentTag 
Const hpLastTag 
Const TopLinkTag 



As String 
As String 
As String 
As String 



"<!- 
"<! 
"<! 
"<! 



/p 0/0 — >" 
/hp — >" 
hp last -->" 
top link — >" 



Const begTitleText As String 
Const endTitleText i?s String 



"< ! — 


/btt — >" 


"<! — 


/ett — >" 


"<!-- 


/btwocollist — > 


"<!~ 


/etwocollist — > 


"<! — 


/bbooklist — >" 


"<! — 


/ebooklist — >" 



Public Const begMenu As String = "<! — /bmenu — >" 
PubMic Const endMenu As String = "<!— /emenu — >" 



Public Const begTable As String 
Public Const endTable As String 

Public Const begLink As String = 
Public Const endLink As String = 



"<!-- 
"<! — 



/btable — >" 
/etable -->" 



ii » 



n ■ 

Pub3|Lc Const paraDelimiter 
Public Const linkMap ; 
Public Const docMap 
i 

Public Const topText 

Public Const bottomText 

Public Const indexlRetujrn 

text template is 

Public Const index2Return 

text template is 

Public Const mainlndexReturn 

link text template is 

Public Const HIILegal 

is 

Public Const indexlToken 
link token 

Public Const index2Token 
link token 

Public Const mainlndexTo ken 



As 
As 
As 

As 
As 
As 

As 

As 

As 



String 
String 
String 

String 
String 
String 

String 

String 

String 



"linkmap.lmf" 
"docmap.dmf " 

"top.txt" 'where the top text template is 
"bottom* txt" 'where the bottom text template is 
"indexlReturn.txt" 'where the index 1 return link 

"index2Return.txt" 'where the index 2 return link 

"mainlndexReturn. txt" 1 where the main index return 

"HIILegal.txt" 'where the HII legal text template 



As String = "<!— indexlReturn — >" 'where the index 1 return 
As String = "<!— index2Return — >" 'where the index 2 return 
As String = "<!— mainlndexReturn — >" 'where the main index 
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return link token 

Public Const HIILegalTokenZ 

Public Const moduleToken 

Public Const moduleToken2 

Public Const moduleBackToken 

referenced" 



As String = "<!— HIILegal -->" 'where the HII ^egal text token 
As String = "$module$" "where the HII legal text token 
As String = "$module2$" "where the HII legal text token 
As String = "$moduleback$" "where the background image is 



Public Const commentTags As String 

level as article folder 

Public Const af terTitleTag | As String 
last title i 
Public Const tokensToHTML As String 

level as article folder 

Public Const addTopAndBottom As String 
same level as article folder 
t *** 

»*** These constants are used as inserted text 
i *** 

Public Const htmlParaStart 
Public Const htmlParaEnd 



"commentTags" "assume Conversions folder at same 
«<} — after title — >" 'used to show, location after 
"tokensToHTML" "assume Conversions folder at same 
"addTopAndBottom" "assume Conversions folder at 



As String = "<p>" 
As String « "</p>" 



Public Const htmlBQStart 
Public Const html BQEnd 

PubtHc Const htmlPreStart 
Pub|fltc Const htmlPreEnd 

Pubflfic Const htmlBoldStart 
Public Const htmlBoldEnd 



As String - "<blockquote>" 
As String = "</blockquote>" 

As String = "<pre>" 
As String = "</pre>" 

As String = "<b>" 
As String = "</b>" 



Public Const htmlStartArticleFooter As String 
Public Const htmlEndArticleFooter As String 



Public Const htmlStartComment 
PubJic Const htmlEndComment 

Public Const htmlStartHead 
PuBSc Const htmlEndHead 

Public Const htmlStartTitle 
Public Const htmlEndTitle 



As String 
As String 

As String 
As String 

As String 
As String 



"<! — start of footer — ><BR><HRXBR><EM>" 
"</EM><PXHR><! — end of footer — >" 

"<! — " 
it 

«<t — start of header — ><HEADXTITLE>HI I - 
"</TITLE></HEAD><! — end of header — >" 

"<H1 align=centerXB>" 
"</BX/Hl>" 



Public Const htmlTopLinkStart As String - "<brximg src=" & qq & ".. /images/bullet . gif" & qq & 

- ■ ^ » align=TOP width=13 height=13xa href=" & qq & 

"#" "start of links at top of article 



Public Const htmlBreak 


As 


String 




"<br>" 


Public Const htmlHorizontalRule 


As 


String 




"<hr>" 


Public Const htmlLessThan - 


As 


String 




"<" 


Public Const htmlGreaterThan 
i 


As 


String 




">" 


Public Const htmlAStart 


As 


String 




"<A href=" 


Public Const artDir 


As 


String 




"art/" 


Public Const htmlET 


As 


String 






Public Const htmllmgStart 


As 


String 




"<IMG SRC=" 


Public Const htmllmgEnd 


As 


String 




" align=center vspace=30 hspace=30>" 


Public Const htmlPressHere 


As 


String 




"<font size=5XB>Press here to view a full 
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size picture. </B></font>" 










Public Const 


htmlAEnd - 


As 


String 


= 


"</A>" ~ 


Public Const 


htmlGoGif 


As 


String 




"go.gif" 


Public Const 


html Alt 


As 


String 




" alt=" 


Public Const 


html Go 


As 


String 


= 


"{Go There)" 


Public Const 


html HTML 


As 


String 




".html" 


Public Const 


htmlNoBorder 


As 


String 


= 


" border=0>" 


Public Const 


+• 4- +- 


As 


String 




"# H 


Public Const 


htmlGoThere 


AS 








border=0>" 


I 










rUDilC L-Onst 
i 


I 


As 


String 


= 


"""" 'double quote 


Public Const 


docTopToken 


As 


String 


— 


"<!— top of article — >" 


Public Const 


docBottomToken 


As 


String 




"<! — bottom of article — >" 


Public Const 


startAnchorToken 


As 


String 




"<p><A Name=" & qq 


Public Const 


endAnchorToken 


As 


String 




qq & "></a>" 


Public Const 


wildCopyRight 


As 


String 




"Copyright [1-2] [0-9] [0-9] [0-9] Clinical 



Reference Systems" 
i *** 

i*** ASP includes 

Public Const ASPdocmain 
£ qj& "— >" 
PubMc Const ASPdochdrl 

PublS c Const ASPdochdr2 
& q<p& " — >" 
Pubj|c Const ASPdochdr3 
& q|:& "— >" 

' ■ 

1 

t**y Inserted debugging tags 

Public Const endTagDebug 
PubGc Const vTagDebug 
Public Const qTagDebug 
PubfLic Const pTagDebug 

Public Const missingParaDelimiterDebug As String 
Delimiter — >" 

Public Const missingTitleDebug 
Tag ~>" 

Public Const titleEndDebug 
— >" 

Public Const deletedCopyrightDebug 
Public Const missingLinkMapDebug 
— >" 

Public Const missingDocMapD.ebug 
— >" 



'note ???? wildcard for year 

As String = "<! — #include virtual=" & qq & "/include/docmain.inc" 

As String = "< ! — #include virtual=" & qq & "/include/dochdrl . inc" 

As String = "<! — #include virtual^" & qq & M /include/dochdr2 . inc" 

As String = "<! — #include virtual=" & qq & ,r /include/dochdr3*inc" 



As String = "<!— 

As String = "<!-- 

As String = "<!— 

As String = "<!-- 

= "<! — 

As String « "< ! — 



Debug: Fake endTag — >" 

Debug: Missing vTag — >" 

Debug: Missing qTag — >" 

Debug: Missing pTag — >" 

Debug: Missing Paragraph End 



Debug: Missing Article Title Start 
As String = "<! — Debug: Missing Article Title End Tag 



As String = "<!- 
As String = "<!- 



Debug: Deleted Copyright — >" 
Debug: Missing target in linkmap.lmf 



As String - "<! — Debug: Missing target in docmap.dmf 



Public Sub s tripEndRe turns ( ) 
Dim allClear As Boolean 

allClear = False ^initialize 

Selection. EndKey unit :^wdStory, Extend :=wdMove x move to end of document 



14 



Selection. MoveLeftr£xtend:=wdExtend * select last character ~ 
If ( Selection. Text vbCr) Or (Selection .Text - vbCrLf) Then 
Selection. Text = 

Selection . Collapse wdCollapseS tart 

Else 

allClear = True 

Selection. ExtendMode = False 'cancel selection extend 

End If 
Loop Until allClear j 

Selection. HomeKey unit :|=wdStory, Extend :=wdMove A move to start of document 
End Sub 



'*** special handling for text which begins with startText 
■*** and ends with endText 

'*** Enclose this text with HTML codes htmlOpen and htmlClose 

t*** deleteFirst is true if first character should be deleted (i.e a "["} 

'*** deleteLast is true if last character should be deleted (i.e a "]") 



Public Sub specialText(ByVal startText As String, ByVal endText As String, _ 

ByVal htmlOpen As String, ByVal htmlClose As String, _ 
m ByVal deleteFirst As Boolean, ByVal deleteLast As Boolean) 



^election. HomeKey unit :=wdStory 

J§impleFind startText 

[S>o While Selection. Find. Found 



'move to start of doc 

'find start of special text - if any 



'move to beginning of selected text if startText not to be deleted 
If Not deleteFirst Then Selection. Collapse direction :=wdCollapseS tart 

Selection. Text = htmlOpen 'HTML start text token, overwrites if deleteFirst 

Selection. Collapse wdCollapseEnd 

SimpleFind endText x find end delimiter 

W if Selection. Find. Found Then 
O If Not deleteLast Then 

C3 Selection. Collapse direct ion: -wdCollapseEnd x move to end of selected text 

if "bhdText not to be deleted 



Loop 
End Sub 



End If 

Selection. Text - htmlClose 
Selection. Collapse wdCollapseEnd 

Else 

Selection . EndKey 
Selection. Text = htmlClose 
Selection. Collapse wdCollapseEnd 
End If 

SimpleFind startText 



'HTML end text token 



'move to end of line, at least do one line 



'find next start of special text 



Public Sub preformattedText (ByVal startTag As String, ByVal endTag As String) 



t *** 
i *** 



This routine requires a start tag and end tag. 

The start tag is used to find and mark the beginning of 

Preformatted text blocks . 
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1 

t *** 
i *** 

i *** 



The end tag is used to find and mark the end of 
Preformatted text ilocks. 

The global constants html P restart and htmlPreEnd are used. 
The are expected to be <pre> and </pre>, but don't have to be. 



Dim docText As String 
Dim paraLoc As Long 
Dim tagLen As Long 
Dim fakeEnd As Boolean 

fakeEnd = False = 
i *** 



'stores text to be cleaned of 
'place keeper for location of 



delimiter 
delimiter 

'used to subtract endTag from selection 
'keep track of when an endTag is forced 



^initialize 



'always know where you are 
'find start of list if any 



art 



Selection. HomeKey unit :=wdStory 
SimpleFind startTag 
Do While Selection. Find. Found 

Selection. Text = startTag & htmlPreStart 

Selection . MoveDown unit : =wdParagraph 

Selection. ExtendMode = True 

SimpleFind endTag 

If Selection. Find. Eound Then 
tagLen = Len(esdTag) 
fakeEnd = False 

Else 

SimpleFind fTag 
^ If Selection. Find. Found Then 

tagLen = Len(fTag) 
4~ fakeEnd = True 

Lil Else 

*|C SimpleFind crTag 

Lfl If Selection. Find. Found Then 

p tagLen = Len(crTag) 

» fakeEnd = True 

S3. Else 

m Selection. EndKey unit :=wdStory, Extend :=wdEx tend 

resort 



(top) 



'start of preformatted list 
'move to line following tag 

'selection includes table 
'legit endTag was found 



* force an end is none found 
'look for article footer 



'fTag was not found, keep looking 
'look for article copyright 



'crTag was not found, use last resort 

'extend to end of 



Le as last 

tagLen = 0 
fakeEnd - True 
End If 
End If 
End If 



Mont really have a tag 



Selection. ExtendMode = False 
Selection. End = Selection. End - tagLen 
docText = Selection. Text 
paraLoc = InStr (docText, paraDelimiter) 
Do While paraLoc > 0 

docText = Left (docText, paraLoc 



'end extend selection 

'deselect tag leaving only text selected 



'save the text for cleaning 
'find location of 
'only bother if there is a "" 
1) & _ 

Right (docText, Len (docText) - paraLoc) 'strip "" 

paraLoc = InStr (docText, paraDelimiter) 'find location of next "" 



Loop 



tag 



Selection. Text = docText 'replace selected text with cleaned text 

Selection. Collapse direction :=wdCollapseEnd 'collapse insertion point to start of end 



Selection. Text = htmlPreEnd 
Selection. Collapse wdCollapseEnd 
If fakeEnd Then 



'end preformatted list 
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Selection. Text « endTagDebug 'add special tag to allow troubleshooting 

Selection. Collapse wdCollapseEnd — 
End If 

SimpleFind startTag 'look for more preformatted text 

Loop 
End "Sub 

Public Function stripDelimiters (ByVal docText As String, _ 

ByVal delimiterText As String, _ 
I Optional ByVal replacelt As String = "") As String 
1 *** 1 

'*** This function takes the passed docText string and replaces all occurances of 

delimiterText passed to it with the string replacelt. If the optional string replacelt 

'*** is not passed, the delimiter is deleted rather than replaced, 
i *** 

Dim delLoc As Long 'delimiter location in string 

Dim delLen As Long 'lenth of delimiter text 

delLen = Len (delimiterText) 'get delimiter text length 

delLoc = InStr (docText/ 5 delimiterText) 'find location of passed delimiter 

.Do While delLoc > 0 'only bother if there is a delimiter 

M docText = Left (docText, delLoc - delLen) & replacelt & 

Right (docText, Len (docText) - delLoc - delLen + 1) 'rebuild string with 

replaced or deleted delimiter 

~R delLoc = InStr (docText, delimiterText) 'find location of next delimiter in title 

iloop 'finished with this section 

spilt ripDelimiters = Trim(docText) 'strip leading and trailing spaces 

End||function 

Public Function convertCharacter (ByVal inputString As String, 
p ByVal v As String, _ 

ffk ByVal r As String) As String 

***f^ This function takes the passed input string and replaces all occurances of 
f ***J character "v" passed to it with the character in "r". 

r Bim vLoc As Long . 'delimiter location in string 

Dim outputString As String 'place to build output string 

Dim s As Long 'continue search from here 

i 

outputString = 

vLoc = InStr (inputString, v) 'find location of passed delimiter 

Do While vLoc > 0 'only bother if there is a delimiter 

outputString = outputString & Mid (inputString, s, vLoc - s) & r 'build output string 
with V replaced with "r" 
s = vLoc + 1 

vLoc = InStr (s, inputString, v) 'find location of next "v" in string, start looking 
after last "v" 

l>oop 'finished with this section 

outputString = outputString & Right (inputString, Len (inputString) - s + 1) 
convertCharacter = outputString 'strip leading and trailing spaces 

End Function 
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Public Sub InsertBottomText () - 

Dim bottomString As String^ 

Dim indexlString As String 

Dim index2String As String 

Dim mainlndexString As String 

Dim HIILegalString As String 

bottomString = getFile (conversions Folder & ":" & bottomText) 
indexlString = getFile (conversionsFolder & ":" & indexlReturn) 
mainlndexString = getFile (lonversions Folder & ":" & mainlndexReturn) 
HIILegalString « getFile ( conversionsFolder £ " : & HIILegal) 

Selection. HomeKey unit :=wdStory 

SimpleFind docBottomToken >find where to stick bottom text 

Selection. Collapse wdCollapseEnd 
Selection. Text » vbCr & bottomString 

Selection. HomeKey unit : =wdStory 
SimpleFind indexlToken_- 
Selection. Collapse wdCollapseEnd 
Selection. Text = indexlString 



iielection. HomeKey unit :=wdStory 
.JimpleFind mainlndexToken 
^election . Collapse wdCollapseEnd 
^Selection. Text = mainlndexString 

^election. HomeKey unit : ^wdStory 
JjSimpleFind HIILegalToken 
'Selection, Collapse wdCollapseEnd 
JSelection.Text = HIILegalString 

^election. HomeKey unit :™wdStory 
IgleplaceEvery moduleToken, moduleGif 
lielection. Collapse wdCollapseEnd 

flf secondlndex Then - 

Selection. HomeKey unit :=wdStory 

index2String « getFile (conversionsFolder & " : " & index2Return) 
SimpleFind index2Token 
Selection. Collapse wdCollapseEnd 
Selection. Text index2 String 
Selection. HomeKey unit :=wdStory 
ReplaceEvery moduleToken2 / moduleGif2 
Selection. Collapse wdCollapseEnd 
End If 
End Sub 

Public Sub InsertTopText ( ) 
Dim topString As String 

topString = getFile (conversionsFolder & ":" & topText) 
Selection. HomeKey unit :=wdStory 
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SimpleFind docTopToken x find where to stick top text 

Selection. Collapse wdCs£L lapse End 
Selection. Text = vbCr £ topString 

Selection. Home Key unit :=wdStory 

SimpleFind cTag 

If Selection. Find. Found Then 

Selection. Text = ASPdochdrl & vbCr & cTag ^insert includes file ref 

Selection. Collapse wdCollapseEnd 
End If | 

Selection. HomeKey unit : =wdStory 
ReplaceEvery moduleBackToken, moduleBack 
Selection. Collapse wdCollapseEnd 
End Sub 



Public Function getFile (ByVal fileName As String) As String 
i *** 



Read a complete file into a string 



Dim fileNumber As Long 
Dim inputString As String 



lletFile = "" 
fileNumber - FreeFile 

^ppen fileName For Input As #fileNumber 
„"|o While Not EOF ( fileNumber) 

Line Input #fileNumber, inputString 
j~ getFile = getFile & inputString & vbCr 

;SiOOp 

jJjSlose #fileNuraber 
End sr f unction 



^get next available file number 
A open external file for read 

x read in a line 
x build result string 

*close file 



Public Sub tweakModuleName ( ) 

: „ 'i 

' ** *lf Take entered module name and fix name, 
T **fe determine if there is a second index 
and set lowercase name. 



moduleGif2 = "none" 



Mefault to no gif 2 



Select Case moduleName 

Case "AHA" _ _ A 

secondlndex = False 
moduleName = "AHA" 
moduleGif = "aha" 
moduleBack = "ahaback" 

Case "PA" 

secondlndex - False 
moduleName = "PedAdv" 
moduleGif - "pa" 
moduleBack = "paback" 
Case "BHA" 

secondlndex = True 
moduleName = "BHA" 
moduleGif « "bhal" 
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moduleGif2 - "bha2" 'only BHA has a second index in second gif (for now) 

moduleBack = "bhaback" ^ 
Case "WHA" * 

secondlndex = False 

moduleMame = "WHA" 

moduleGif - "wha" 

moduleBack = "whaback" 
Case "SHA" 

secondlndex = False 

moduleName = "%HA" - 
moduleGif = "sia" 
moduleBack = "shaback" 
Case "CA M 

secondlndex = False 
moduleName = "CA" 
moduleGif = "ca" 
moduleBack = "caback" 
Case "OA" 

secondlndex = False 
moduleName = "OA" 
moduleGif = "otf" 
moduleBack = "oaback" 
Case "SMA" 
fj secondlndex = False 

moduleName = "SMA" 
,fj moduleGif = "sma" 

j~ moduleBack = "smaback" 

Case "MA" 

£ i z 

W p secondlndex = False 

^ moduleName = "MedAdv" 

JLj moduleGif = "ma" 

* M moduleBack = "maback" 

l_ Case Else 

y secondlndex = False 

W moduleName = "DebugMePlease" 

W moduleGif = "debugMe" 

O moduleBack = "debugmeback" 

find Select 
Endf&ub 



Option Explicit 

Public Sub Make2ColumnList {) 

preformattedText beg2ColList, end2ColList 
column lists 
End Sub 

r ^==:==:========:=r= == : == 

Option Explicit 

Public Sub MakeBookList () 

preformattedText begBookList, endBookList 
booklists 
End Sub 



^add preformatting start end end tags to 2 



*add preformatting start end end tags to 
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Option Explicit 

Public Sub MakeLists() ^ ~ 

i*** This routine looks for the various list tags and processes accordingly. 
'*** Real html lists are created whenever possible. 



preltemList numTag 'use numbered item list pref ormatting 

preltemList letTag A use letter item list Preformatting 

preltemList romTag 1 'use roman numeral item list preformatting * 

preltemList bliTag 1 'use bulleted item list preformatting, except for simple case 

'if simple bulleted list, create actual html list 
bliltems "3/0" 'prettify simple bulleted lists 

1 bliltems "7/4" 'bliltems needs to be debugged for this case, leave as "pre" text for now 

End Sub 

Public Sub preltemList (ByVal listType As String) 
i *** 

This routine searched for the types of list passed to it and simply leaves it 
T *** reformatted. This_J.s ugly, but works for the time being, 
i * * * ^ 

Dim paralnfo As String 'contains the n/m indent information which goes with list tag 

Dim bParaTag As String 'contains html string which is inserted at the beginnning of list 

Dim rflParaTag As String 'contains html string which is inserted at the end of list 

Dim ygistltem As String 'holds a copy of selected list text to process 

Selection .HomeKey unit :=wdStory 'always know where you are (top) 

iffmpleFind vbCr & listType ^find start of list tag 

jfc While Selection. Find. Found 

m Selection. MoveLeft 'leaves insertion point before hard return of previous paragraph 
; n Selection. Mo veDown unit :=wdParagraph 'move to beginning of tag line 

*y Selection. InsertAfter htmlStartComment 'want to comment out tag 

Selection. MoveRight Count :=Len (listType) 'move to right of tag 

m Selection - MoveDown unit:=wdParagraph, Extend :=wdExtend 'select x/x info 

W Selection. End = Selection. End - 1 'deselect hard return 

g paralnfo = Trim (Selection. Text) ^save cleaned selection 

■H Selection. Collapse wdCollapseEnd 'deselect tag 

Selection. InsertAfter htmlEndComment 'finish commenting out tag 

Selection. MoveDown unit :=wdParagraph 'move to beginning of body of list item 

If listType = bliTag Then simple bulleted list, do more processing 

Select Case paralnfo 
Case ^3/0" 

bParaTag = "<li>" 
eParaTag = " " 

Selection. MoveRight Extend: =wdEx tend, Count:=3 'select dash and spaces 
Selection. Range. Delete 'delete same 

Case "7/4" . 

bParaTag = "<li>" 
eParaTag = " " 

Selection. MoveRight Extend : =wdExtend, Count:=7 'select dash and spaces 
Selection. Range. Delete 'delete same 

Case Else 

bParaTag = htmlParaStart & htmlPreStart & vbCr 'indented paragraph of some 
other sort, use as is 

eParaTag = vbCr & htmlPreEnd & htmlParaEnd 'leave as is until I have more 
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time 

End Select — 
Else ' 

bParaTag = htmlParaStart & htmlPreStart & vbCr 'indented paragraph of some other 
sort, use as is 

eParaTag = vbCr & htmlPreEnd & htmlParaEnd 'leave as is until I have more time 
End If 

Selection. InsertAfter bParaTag 'insert html para tag 

Selection. Collapse jwdCollapseEnd - 
SimpleFind par a Delimiter ^find end of list item paragraph 

If Selection. Find. Found Then 

Selection. Text = eParaTag 'replace token with html closing para tag 

Selection. Collapse wdCollapseEnd 

Else 

Selection. MoveUntil cset:="/" "move insertion point until the next beginning of a 
/tag is found 

Selection. MoveLeft ^ moV e to end of previos 

Selection. InsertAfter missingParaDelimiterDebug & eParaTag 'insert a debug msg 
because end of list item tag wasn T t found 

Selection. Collapse wdCollapseEnd 
End If 

SimpleFind vbCr & listType 'find start of next list tag 

Sloop 
End ^|ub 

& 

PubljEc Sub bliltems (ByVal indent As String) 
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now that list item are marked, figure out which list items go together 



Dim rfjaralnf o As String 'contains the n/m indent information which goes with list tag 

Dim BParaTag As String 'contains html string which is inserted at the beginnning of list 

Dim ^ParaTag As String 'contains html string which is inserted at the end of list 

Dim J|istltem As String 'holds a copy of selected list text to process 

Dim Wp Loc As Lon 9 'holds location of /hp tag in listltem 

flection. HomeKey unit :=wdStory A always know where you are (top) 

J^impleFind htmlStartComment & bliTag £ indent 'start of list 

h3b While Selection. Find., Found 

Selection. MoveLeft ? 

Select Case indent 
Case "3/0" 

Selection. InsertAfter "<ul>" & vbCr ^html tag for start of list 

Case "7/4" ^ 

' Selection. InsertAfter htmlBQStart & vbCr & "<ul>" & vbCr "html tag for start of list 

Case Else 
End Select 

Selection. MoveDown unit : =wdParagraph 'prevent infinite loop if no /p 

Selection. Ext endMode = True . 'get tricky 

SimpleFind pCommentTag ^find end of list - assume next para 

If Selection. Find. Found Then 

listltem - Selection. Text *save selection to manipulate 

hpLoc = InStr (listltem, hpCommentTag) "find first occurance of primary header, if 

any 

Selection. ExtendMode = False 

If hpLoc = 0 Then 'no precluding /hp - an /hp tag would occur after end of list 
Selection. Collapse wdCollapseEnd 'collapse selection to end after pCommentTag 
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Selection. MoveLeft Count : =Len (pCommentTag) 'move insertion point to before 
pCommentTag to insert </u±> ' 
Else 

Selection. Collapse wdCollapseStart 'go back before "<! — /bli" tag 

SimpleFind hpCommentTag 'find end of list - we know it is <! — /hp — > 

Selection. MoveLeft x now we're in the right spot 

End If 

Else x no pCommentTag found to end list, look for next header 

Selection. ExtendMode = False 

SimpleFind hpCommentTag 'find end of list - assume next header 

If Selection. Find. Found Then 

Selection. Collapse wdCollapseStart * right spot to insert </ul> 

Else 

SimpleFind html Start Comment & bliTag & indent 'find next list item 

Do While Selection. Find. Found 

SimpleFind htmlStartCoinment & bliTag & indent 'keep finding list items, 
there are no intervening /p or /hp 
Loop - 

Selection. MoveDown unit : =wdParagraph * start next find in next paragraph 

SimpleFind html Start Comment 'find next tag as assumed end to list 

Selection. Collapse wdCollapseStart 'collapse tostart of tag 

m End If 

End If 

■ Hjjjj this point we are at the presumed end of the simple bulleted list. 

y§ 

«?J Select Case indent 
Case "3/0" 

a- Selection. InsertAfter "</ul>" & vbCr 'html tag for end of list 

O case "7/4" 

C§ Selection. InsertAfter "</ul>" & vbCr & htmlBQEnd & vbCr 'html tag for end of list 
|y Case Else 

p End Select 

Select ion. MoveDown unit : =wdParagraph 'prevent infinite loop if no /p, /hp 

SimpleFind html St art Comment & bliTag & indent 'find start of next list 

Loop 
End Sub 

Si 

Option Explicit 
Public Sub MakeMenu ( ) 

preformattedText begMenu, endMenu 'add preformatting start end end tags to menus 

End Sub 



Option Explicit 

Public Sub MakeParagraphs ( ) 

f -k-k-k 

'*** Change /p tags into html paragraphs 
j *** 

Dim paralnfo As String 'info after the /p, e.g. 0/0 
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Dim bParaTag As String~- 
Dim eParaTag As String- 



' always know where you are 
'start of para tag 



'what? no /p? add debug message 
Mon't bother with rest 



Selection. HomeKey unit :=wdStory 
SimpleFind vbCr & pTag 
If Not Selection. Find. Found Then 

Selection. InsertAfter pTagDebug 
Selection. Collapse wdCollapseEnd 
Exit Sub 
End I f 

Do While Selection. Find. Found 
Selection. Mo veLe ft 

Selection . MoveDown unit : =wdParagraph 

Selection. InsertAfter htmlStartComment 'want to comment out tag 

Select ion. MoveRight Count:=3 'move to right of tag 

Selection, MoveDown unit :=wdParagraph, Extend: =wdEx tend 'select x/x info 



3 

I 



J'l 



Selection. End = Selection. End - 1 

paralnfo = Selection. Text 
paralnfo = Trimfpalgalnfo) 

Selection . MoveRight 

Selection. InsertAfter htmlEndComment 
Selection. MoveDown unit :=wdParagraph 

Select Case paralnfo 
Case "0/0" 

bParaTag = htmlParaStart 

eParaTag = htmlParaEnd 
Case "2/0" 

bParaTag = htmlParaStart 

eParaTag = htmlParaEnd 
Case "0/4" 

bParaTag = htmlParaStart 

eParaTag = htmlParaEnd 
Case "4/4" 

bParaTag = htmlBQStart 

eParaTag « htmlBQEnd 
Case "4/5" I 

bParaTag - htmlBQStart 

eParaTag = htmlBQEnd 
Case Else 

bParaTag = htmlParaStart & htmlPreStart 
eParaTag = htmlPreEnd & htmlParaEnd 
End Select 



'deselect hard return 

'save selection 
* clean up info 



* finish comment 

'simple paragraph 
'simple paragraph 
'simple paragraph 



' indented paragraph 

'use blockquote to simulate indent 

' indented paragraph 

'use blockquote to simulate indent 



'indented paragraph of some sort 
'leave as is until I have more time 



'insert html para tag 
'find token for end of paragraph, namely 

'replace token with html closing para tag 



Selection. InsertAfter bParaTag 
Selection. Collapse wdCollapseEnd 
SimpleFind paraDelimiter 
If Selection. Find. Found Then 

Selection. Text = eParaTag 

Selection. Collapse wdCollapseEnd 
Else 'geeze, where 1 s the delimiter? 

Selection. InsertAfter missingParaDelimiterDebug ^insert yet a nother debug comment 

Selection. Collapse wdCollapseEnd 

End If 

SimpleFind vbCr & pTag 'find next paragraph 
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Loop 
End Sub 



Option Explicit 

Public Sub MakeTables () 

preformattedText begTable, endTable 'add pref ormatting start end end tags to tables 

End Sub ^ 



Option Explicit 

Public Sub multiReplace(ByVal pairsFile As String) 



i *** 

i*** Read pairs of find/ replace strings from an external file and perform ReplaceAll 

'*** Intended to replace the Add/Strip steps of the original conversion procedure, 
t *** 

1 *** pairsFile => filename of the file containing the find/replace pairs 

t*** file format is as follows: 
t *** 

1 ***£3 x,y, z, search, replace 

i * * * 

1 where: 

i***5 x => "1" or "0" mapped to "enabled", find/ replace is skipped if 

1 ***TE enabled = "0" 



f*** % JJ y -> "1" or "0" mapped to "caseSensitive", case is ignored in 

T ***4~ search/ replace if caseSensitive ~ "0" 

i***MJ z "1" or "0" mapped to "useWildCards", wildcard search/replace is 

enabled if useWildCards = "1" 

search => search string mapped to "findString" 
»***3 replace => replace string mapped to "replaceString" 

i * * 4lJ 

t**4y note: if "findString" or "replaceString" have embedded double quotes <"> or commas 
'**C| <,>, they appear in the conversion file as a bar character <|> or bullet <>, 

respectively. The bar and bullet characters were used in the conversion file 
1**4^ since the since the double-quote and comma characters are delimiters for the 

i*** file read function. The "convertCharacter" function fixes this, 

i *** 
i 

Dim fileNumber As Long 
Dim enabled As String 
Dim caseSensitive As String 
Dim useWildCards As String 
Dim findString As String 
Dim replaceString As String 

Reset 'make sure all low level access files are closed 

fileNumber « FreeFile ' x get next available file number 

1 Debug. Print pairsFile 
1 Debug. Print fileNumber 
1 Debug. Print CurDir 

Open pairsFile For Input As #fileNumber 'open external file for read 

Do While Not EOF (fileNumber) 

Input #fileNumber, enabled, caseSensitive, _ 

useWildCards, findString, replaceString 'read in a find/ replace pair 
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findString = conveftCharacter (findString, "|", Chr(34)) 'make quotes real 

replaceString = convert Character (replaceString, "i", Chr(34)) 'make quotes real 
findString - convertCharacter (findString, ",") "make commas real 

replaceString = convertCharacter (replaceString, "", ",") "make commas real 



1 Debug. Print enabled 
'Debug. Print caseSensitive 
'Debug. Print useWildCards 
'Debug. Print findString ^ 
1 Debug . Print replaceString § 

'Debug. Print " " 

If enabled = "1" Then 
'call ReplaceAll method 

ActiveDocument . Content . Find . Clear Formatting 
ActiveDocument . Content . Find . Replacement . ClearForma tting 



With ActiveDocument. Content. Find 

.Text = findString 

.Replacement. Text = replaceString 

.Forward =sTrue 

.Wrap = wdFindContinue 
x** .Format = False 

If caseSensitive = "1" Then 
■Hf .MatchCase = True 

W Else 

™F .MatchCase = False 

Ifl End If 

42 .MatchWholeWord = False 

Ifl If useWildCards = "1" Then 

rp .MatchWildcards = True 

s Else 

pii .MatchWildcards = False 

Ifl End If 

1^1 . Mat chSounds Like « False 

S .MatchAllWordForms = False 

-5 .Execute Replace :=wdReplaceAll 

JT End With 

^ End If 
Loop 

Close #1 ' close file 

End Sub 



Option Explicit 

Public Sub PreformattedListsandTables () 

pref ormattedText beg2ColList, end2ColList 
column lists 

preformattedText begBookList, endBookList 

booklists 

preformattedText begMenu, endMenu 'add 
preformattedText begTable, endTable 'add 
End Sub 



'add Preformatting start end end tags to 2 

'add preformatting start end end tags to 

Preformatting start end end tags to menus 
Preformatting start end end tags to tables 



Option Explicit 
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Public Sub SectionLinks ( ) — 



Creates internal document links based upon 
i*** section titles started by "/hp" tag aka "hpTag'V 



i *** 



Dim linkCount As Long * keeps a running count as to how many links have been made 

Dim sectionTitle As String 'title of a subsection used to make a link at top of doc 

Dim linklndex As String 'holds anchor index name 

Dim paraLoc As Long ^ 4 

linkCount = 0 
sectionTitle = 
linklndex = 

Selection. HomeKey unit :=wdStory 'start at the top 

SimpleFind hpCommentTag 'find first primary heading 

Do While Selection. Find. Found 

Selection. MoveDown unit :=wdParagraph 'move to beginning of next paragraph 

Selection, ExtendMo<ie = True 

SimpleFind " A p/" -i 'select to next if found 

If Selection. Find. Found Then % HA p/" was found 

Selection. End = Selection. End - 2 'shrink selection to just title text 

Selection. ExtendMode = False 
W linkCount = linkCount + 1 'point to next link, starts at "1" 

^3 linklndex = Format (linkCount) 'make count into a string, use Format ( ) for no 

leading space 

WI sectionTitle = Selection. Text 'copy section title w/"" characters if any 

»C sectionTitle = stripDelimiters (sectionTitle, paraDelimiter, " ") 'clean section 

tiljfe of characters 

Ifl sectionTitle - stripDelimiters (sectionTitle, vbCrLf, " ") 'clean section title of 

hard return characters 

O sectionTitle « stripDelimiters (sectionTitle, vbCr, " tt ) 'clean section title of 

harSf return characters 

. I * ij 

?t*** insert the new text including tokens where html will be added in place of selection 
11*** 

Selection. Text htmlBreak & startAnchorToken & linklndex £ _ 

endAnchorToken & sectionTitle & htmlParaEnd & hpLastTag 
Selection. Collapse wdCollapseEnd 

Selection. HomeKey unit :=wdStory 'go to top of doc to insert link to just added 



anchor 



SimpleFind TopLinkTag 'this is where the top links go 

Selection. Text = htmlTopLinkStart & linklndex & qq & _ 
htmlET & sectionTitle & htmlAEnd & _ 

vbCr & TopLinkTag ' insert actual link, leave top link for next one 
Selection. Collapse wdCollapseEnd 

SimpleFind hpLastTag 'go back to where we left off 

Selection. Text '= "" 'delete last seen tag 
End If 

SimpleFind hpCommentTag 'find next primary heading 

Loop 'while primary header found 

Selection. HomeKey unit:=wdStory 'go back to top 

SimpleFind TopLinkTag 'go back to end of last inserted link at top 

If Selection. Find. Found Then 'make sure there were some links added 
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Selection. Text = vbCr & vbCr 
Selection. Collapse wdCollapseEnd 
Selection. Text = ASPdochdr2 £ vbCr 
Selection. Collapse wdCollapseEnd 

Else 

SimpleFind af terTitleTag 
Selection. MoveDown unit :=wdParagraph 
Selection. Collapse wdCollapseEnd 
Selection. Text = vh£r & ASPdochdr2 & 
Selection. Collapse JrdCollapseEnd 
End If 

Selection. HomeKey unit :=wdStory 
End Sub 



^include dochdr2 for asp 

^must assume this exists 
^rnove down to after main title 

% include dochdr2 for asp 
^leave at top of doc 



The followiung is the macro which is used to convert indexes 
Some of the subroutines and functions have the same names as 
earlier referenced ^routines, but they are private to this macro set 
Listed as independent macro for temporary development use to facilitate 
Debugging and to permit slightly altered code in some subroutines 



OptiSn Explicit 
Pubilc indexName As String 
PublB-c index2Name As String 
Public workingDirectory As String 
Publgc targetFolder As String 
Publkc conversionsFolder As String 
PubMc moduleName As String 
Public moduleGif As String 
Public moduleGif 2 As String 

Pub^c moduleBack As String ^name of background gif 
Public secondlndex As Boolean 

Public currentFile As String A so we only have to check once 
Public currFileWindow As String 
'PuKlic linkMapWindow As String 
1 Public docMapWindow As String 

Public namePart As String 
Public currAlpha As String 

Public Sub preplndex() 

!*** 

**** set up parameters 
t *** 

Application. DisplayScrollBars = False 
'Application* DisplayStatusBar = False 
Application. ScreenUpdating » False 

Dim cur r File As String' 

Dim extPart As String 

Dim saveName As String 

Dim messageText As String 

Dim moduleCount As Long 

cur r File = 
saveName = 
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namePart - "" 
extPart = 



messageText - "Enter module code:" & vbCr & _ 

"AHA - Adult Health Advisor" & vbCr & 
"PA - Pediatric Health Advisor" & vbCr & _ 
"BHA - Behavioural Health Advisor" & vbCr & 
"WHA - Women's Health Advisor" & vbCr £ _ 
"S^A - Senior Health Advisor" & vbCr & _ 
"Cj - Cardiac Health Advisor" & vbCr & _ 
"OA - Ophthalmology Health Advisor" & vbCr & 
"SMA - Sports Medicine Advisor" & vbCr & _ 
"MA - Medications Advisor" & vbCr 



moduleName = InputBox (messageText, "Module Name Entry", "AHA") 

tweakModuleName ^set some globals based on entered module name 

workingDirectory = getArticlePath ( ) x get working directory which contains raw articles 

targetFolder = makeTargetFolder (moduleName) ^create a folder to save converted articles 
and indexes 

conversionsFolder - sefeConversions Folder { "Conversions") 



^currFile = Dir( H ") '(workingDirectory) 
KiurrFile = StrConv( currFile, vbLowerCase) 



^retrieve first file 



k3>o While currFile <> "" x null string is returned when no more files in folder 

JJ namePart = getNamePart (currFile) ^seperate the current filename into namepart and 
extg&sion part 

B g extPart = getExtPart (currFile) 

(n ChDir workingDirectory 

m Documents .Open _ 

I' fileName:=currFile f _ 

^ ConfirmConversions^False, _ 

l%- addToRecentFiles:=False, _ 

H Format :=wdOpenFormatText *open current file for processing 

f ™2 currentFile = ActiveDocument .Name A get current filename sans path 
;jf convertlndex x convert as index file 

M Documents (currFile) . Close s a ve change s : =wdDoNotSaveChanges 
$™ currFile = Dir *get next file 

currFile = StrConv (currFile, vbLowerCase) 

Loop 



Application. DisplayScrollBars — True 
'Application. DisplayStatusBar - True 
Application. ScreenUpda ting = True 
End Sub 



Private Sub convertlndex ( ) 
Dim linkText As String 
Dim saveName As String 
Dim n As Long 

Dim newSublndex As Document 

removeNonlndexLines x get rid of extraneous stuff 

For n = 65 To 90 

currAlpha = Chr(n) 

linkText = getCurrAlphaLinks 

Set newSublndex - Documents .Add 
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Documents (newSublndex) .Activate _ 

Selection. Text =* lihkText 

Selection -Collapse wdCollapseStart 

format IndexLinks 

Selection. HomeKey unit :=wdStory 

InsertTopText 

InsertBottomText 

ReplaceEvery ,,A p A p A p", vbCr 

saveName = targetFcj.der & & namePart & & StrConv( cur rAlpha, vbLowerCase) 

"•asp" | 

With Documents (newSublndex) 

. SaveAs f ileName : ^saveName, FileFormat : =wdFormatText 
.Close 
End With 
Next n 
End Sub 

Private Sub f ormatlndexLinks { ) 
Dim link As String 
Dim tildeLoc As Long -= 
Dim linkLen As Long 

i** 4.3 

1 Clean up non link lines 

Selection. HomeKey unit :=wdStory 
ReplfceEvery "- A p", ,fA p" 

'**tfl format link lines 
• *** 

Selection. HomeKey unit :=wdStory 
Siir|||eFind 

Do Mile Selection. Find. Found 

ttordBasic. Insert "<! >" 

JSelection.MoveDown unit :=wdParagraph f Extend :-wdExt end 
? s 5election.End = Selection. End - 1 
^link — Selection. Text 

Selection. Text = ,tn ■ 

tildeLoc = InStr(link, "~") 

linkLen = Len(link) 

link » Left (link, tildeLoc - 1) & ".asp*" & Right (link, linkLen - tildeLoc) 

link = "<a href=" & Chr(34) & link & Chr(34) & 

Selection. Mo veUp unit : =wdParagraph 

Selection. Text ~ link 

Selection. Collapse wdCollapseEnd 

Selection. ExtendMode - True 

SimpleFind "<! — ~ — >" 

Selection. ExtendMode = False 

Selection. End - Selection .End - 10 

Selection. Text - RTrim( Selection. Text) 

Selection. Collapse wdCollapseEnd 

Selection. Text = "</a>" 

Selection . Collapse wdCollapseEnd 
Selection. End = Selection. End + 10 
Selection. Text = 
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SimpleFind "~" - 

Loop 
End Sub 

f *** 

i*** just search forward for the passed string 
t *** 

Private Sub SimpleFind (By Val findStr As String) 

With Selection. Find J 

.Text = finds tr 

.Forward = True 

.Format = False 

.MatchAllWordForms - False 

.MatchCase = False 

.MatchSoundsLike = False 

.MatchWholeWord = False 

.MatchWildcards = False 

.Wrap = wdFindStop__ 

.Execute 
End With 
End Sub 

'**^0 search and replace forward using the passed strings for all occurances 

Private ■ Sub ReplaceEvery (ByVal findStr As String, ByVal replaceStr As String) 
prelection. HomeKey unit :=wdStory 
fSfith Selection. Find 
3 .Text = findStr 
PI . Replacement . Text =* replaceStr 
|5 .Forward = True 
f B V | . Format = False 
JZ .MatchAllWordForms = False 
:!? .MatchCase = False 

.MatchSoundsLike = False 
^ .MatchWholeWord = False 

.MatchWildcards = False 

.Wrap — wdFindContinue 

.Execute Replace :=wdReplaceAll 
End With 

Selection. HomeKey unit:=wdStory 
End Sub 

Private Sub tweakModuleName ( ) 
t *** 

1 *** Take entered module name and fix name, 
i*** determine if there is a second index 
1 *** and set lowercase name, 
t *** 

moduleGif2 - "none" Mefault to no gif 2 

index2Name = "none" Mefault to no index 2 

Select Case moduleName 
Case "AHA" 
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secondlndex = -galse — 
moduleName » "AHA" ' 
moduleGif = "aha" 
moduleBack = "ahaback" 

indexName = "Adult Health Advisor Index" 
Case "PA" 

secondlndex = False 
moduleName = "PedAdv" 
moduleGif = "paf 

moduleBack = "jfaback" -* 
indexName - "Pediatric Advisor Index" 
Case "BHA" 

secondlndex = True 
moduleName = "BHA" 
moduleGif = "bhal" 

moduleGif 2 = "bha2 n 'only BHA has a second index in second gif (for now) 

moduleBack = "bhaback" 

indexName = "Behavioral Health Advisor Adult Index" 
index2Name - "Behavioral Health Advisor Pediatric Index" 
Case "WHA" ~i 

secondlndex = False 
moduleName = "WHA" 
moduleGif = "wha" 
moduleBack = "whaback" 

indexName = "Women's Health Advisor Index" 
Case "SHA" 

secondlndex » False 
moduleName = "SHA" 
moduleGif = "sha" 
moduleBack = "shaback" 

indexName = "Senior Health Advisor Index" 
Case "CA" 

secondlndex = False 
moduleName = "CA" 
moduleGif - "ca" 
moduleBack = "caback" 
indexName « "Cardiac Advisor Index" 
Case "OA" 

secondlndex - False 
moduleName = "OA" 
moduleGif = "oa" 
moduleBack = "oaback" 

indexName ~ "Ophthalmology Advisor Index" 
Case "SMA" 

secondlndex - False 
moduleName = "SMA" 
moduleGif = "sma" 
moduleBack = "smaback" 

indexName = "Sports Medicine Advisor Index" 
Case "MA" 

secondlndex = False 

moduleName = "MedAdv" 

moduleGif = "ma" 

moduleBack = "maback" 

indexName - "Medications Index" 
Case Else 

secondlndex = False 
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moduleName = "BebugMePlease" 
moduleGif - "debugMe" 
moduleBack - "debugmeback" 
indexName = "Debug Me Please Index" 
End Select 
End Sub 

Private Function getArticlePath ( ) As String 

I 

t*** The purpose of thisj function is to return the path 
**** for the articles to be converted 



With Dialogs (wdDialogFileOpen) 

. Show 
End With 



'*** it doesn't matter if a file is opened or not, 
**** CurDir returns-^the last navigated path 
return value to calling 

» *** 



getArticlePath = CurDir 
End^lfunction 

PrivMte Function getNamePart (ByVal fileName As String) As String 

! **tfl Return the name part of a filename 

a Dim dotLoc As Long 
f^otLoc « InStr( fileName, ".") 
■ getNamePart = Left {fileName, dotLoc - 1) 
End| .Function 

Prip&te Function getExtPart (ByVal fileName As String) As String 
i * *Jr" 

f**^T Return the extension part of a filename 

Dim dotLoc As Long 

dotLoc = InStr (fileName, ".") 

getExtPart = Right (fileName, Len (fileName) - dotLoc) 
End Function 

Private Function makeTarget Folder (ByVal targetFolder As String) As String 
r *** 

i*** MkDir — > create a folder based on the current path 

**** The part makes it go up one level before creating the directory 

t *** 

Dim saveDir As String 

MkDir & targetFolder ^create target folder on the same level as working folder 

saveDir = CurDir ^save current folder to return to 

ChDir " : : " & targetFolder *go to newly created folder 

makeTargetFolder = CurDir x make the return value of this function be the created folder 
ChDir saveDir A go back to working folder 

End Function 
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Private Function s etConversjLons Folder (ByVal cFolder As String) As String — 

**** MkDir — > create a folder based on the current path 
• *** 

<phe » ;: " part makes it go up one level before creating the directory 

i *** 

Dim saveDir As String 

saveDir = CurDir x save current folder to return to 

ChDir " ::" & cFolder ^ x go to newly created folder 

setConversions Folder = JurDir x make the return value of this function be the created 
folder 

ChDir saveDir x go back to working folder 

End Function 

Private Sub saveSublndex ( ) 

saveName - targetFolder & ":" & namePart & & currAlpha & 11 .asp" 
With Documents (newSub Index) 

.SaveAs fileName:=saveName, FileFormat :=wdFormatText 

.Close 
End Wi£h 

End Sub 

Priff|te Sub removeNonlndexLines { ) 
? ***~f Clean up PC formatted lines 

Selection. Home Key unit :=wdStory 
ReplSceEvery vbCrLf, ftA p" 

1 **fff remove extraneous text, leave only index lines 

Selection «HomeKey unit :=wdStory 
Selection. ExtendMode = True 
SirrfeleFind 

Selfsption . MoveDown unit : =wdParagraph 
Sel§eption. ExtendMode = False 
Selection. Text = 

'*** deleted everything 'at the top at this point 
» *** 

SimpleFind n/v p.Q" 
Selection. Text = 

- - * 

i *** 

deleted everything at the bottom at this point 

End Sub 

Private Sub InsertBottomText ( ) 
Dim bottomString As String 
Dim indexlString As String 
Dim index2 String As String 
Dim mainlndexString As String 
Dim HIILegalString As String 

bottomString « getFile (conversionsFolder & ":" & "subIndexBottom.txt") 
indexlString = getFile (conversionsFolder & " :" & "indexlReturn.txt") 
mainlndexString - getFile (conversionsFolder & " : " & "mainIndexReturn.txt") 
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HIILegalString - get File (conversions Folder & " : " & "HIILegal . txt") 
Selection. EndKey unit :*wdStory x go to bottom 

Selection. Text = vbCr & bottomString 
Selection. HomeKey unit :=wdStory 
SimpleFind "< ! — indexlReturn — >" 
Selection. Collapse wdCollapseEnd 
Selection. Text = indexlString 
Selection. HomeKey unit :-wdStory 
SimpleFind "<! — mainliyiexReturn — >" 
Selection. Collapse wdCqp. lapse End 
Selection. Text = mainlndexString 
Selection. HomeKey unit :=wdStory 
SimpleFind "<! — HIILegal ~>" 
Selection. Collapse wdCollapseEnd 
Selection. Text = HIILegalString 
Selection. HomeKey unit :=wdS tor y 
ReplaceEvery " $module$", moduleGif 
Selection. Collapse wdCollapseEnd 
If secondlndex Then 

Selection. HomeKey -mnit :=wdStory 

index2String = getFile (conversionsFolder & ":" & "index2Return.txt" 
~^ SimpleFind "<! — index2Return — >" 
^ Selection. Collapse wdCollapseEnd 
;™ Selection. Text = index2String 
"!! Selection. HomeKey unit :=wdStory 

ReplaceEvery "$module2$ rt , moduleGif2 

Selection. Collapse wdCollapseEnd 
^Ind If 
End^iub 

Public Sub InsertTopText {) 
DimQtopString As String 

topfp:ring - getFile (conversionsFolder & " : " & "subIndexTop.txt") 
I ^Selection . HomeKey unit : =wdStory 

election. Text = topString & vbCr 
^election . HomeKey unit : =wdStory 
ijf namePart - "index" Then 

ReplaceEvery "$indexName$ n , indexName 
Else 5 

ReplaceEvery "$ indexName $ H , index2Name 
End If 

Selection. Collapse wdCollapseEnd 
Selection. HomeKey unit :-wdStory 
ReplaceEvery ,, $moduleback$" / moduleBack 
Selection. Collapse wdCollapseEnd 
Selection. HomeKey unit :=wdStory 
ReplaceEvery "$A$", currAlpha 
Selection. Collapse wdCollapseEnd 
End Sub 

Public Function getFile (ByVal fileName As String) As String 
t *** 

! *** Read a complete file into a string 
i *** 

Dim fileNumber As Long 
Dim inputString As String _ 
getFile = 
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fileNumber = FreeFile ~ 

Open fileName For Input As # fileNumber 

Do While Not EOF (fileNumber) 

Line Input #f ileNumber, inputString 
getFile = getFile & inputString £ vbCr 

Loop 

Close #fileNumber 
End Function 

Private Function getCurrAl^fiaLinks ( ) As String 
Dim workingString As String 
Dim foundNext As Boolean 
Dim nextAlpha As String 
workings tring = 
foundNext = False 

nextAlpha = Chr (Asc (currAlpha) + 1) 
Selection. HomeKey unit :=wdStory 
SimpleFind " A p" & currAlpha 
If Not Selection. Find. Jlound Then 

getCurrAlphaLinks ^ vbCr & vbCr & vbCr & "Sorry, 

"which begin with the letter 
O Chr (34) & currAlpha & Chr (34) 

& Exit Function 
*Snd If 

Jlo While Selection. Find, Found 
|fl Selection. ExtendMode = True 
„p SimpleFind HA p" & currAlpha 
jftoop 

^workingString = workings tring £ Selection. Text 
" Selection. Text = 11 " 
^election. ExtendMode - False 



^get next available file number 
A open external file for read 

x read in a line 
A build result string 

^close file 



x if you don't find it then git I 
there are no topics " & _ 



* * * 

y£ *** 



need to make sure to handle indented section after last currAlpha 



^election. ExtendMode = True 
j-^bo Until foundNext Or Asc (nextAlpha) > 90 
^ SimpleFind f,A p H & nextAlpha 
If Selection. Find. Found Then 
foundNext = True 
Select! on. ExtendMode = False 
Selection. End = Selection. End - 2 
workingString = workingString $ Selection. Text 
Selection. Text = 

Else 

nextAlpha = Chr (Asc (nextAlpha) + 1) 
End If 

Loop 

If Asc (nextAlpha) > 90. Then 

Selection. EndKey unit :=wdStory 

workingString = workingString & Selection. Text 

Selection. Text = 
End If 

Selection. ExtendMode = False 
getCurrAlphaLinks » workingString 
End Function 



deselect character and hard return 
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